home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / gr_col.exe / GR_COL2G.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-04-17  |  12.5 KB  |  338 lines
  1. { == GR_COL2F.PAS =============================================================
  2.  
  3.   Test writeln in color within graphics. Shows that you CAN write color text
  4.   in graphics, with the correct background!
  5.  
  6.   The "background" cannot be set via TextBackground, but must be drawn with
  7.   graphics, such as Bar
  8.  
  9.   This program demonstrates all 16 VGA text colors against the 16 VGA colors
  10.   as graphics backgrounds.  It shows the background RGB "combined value" (see
  11.   below), the foreground RGB "combined value", and the resulting XOR combined
  12.   value.
  13.  
  14.   The XorColConv procedure calculates the correct VGA color number ( Black:0
  15.   to White:15) which results when a background and foreground color are XOR'd.
  16.   Diagnostic prints within the procedure show the values being manipulated.
  17.  
  18.   If the background and foreground colors COR to a "standard" 16-color VGA
  19.   combined value, TRUE is shown, while FALSE is shown if the "exception"
  20.   look-up table has been used to find the output VGA color.
  21.  
  22.   Take a look at the procedure code and comments to tell you what's happening.
  23.  
  24.   Written by Jerry Rivers. Last modified: 04/16/93
  25.  
  26.   ============================================================================= }
  27.  
  28. PROGRAM Gr_Color;
  29.  
  30.   uses Graph, Crt, DosUtil;
  31.   const
  32.     ColNam : array[0..15] of string[12] = (
  33.               'Black',    'Blue',         'Green',      'Cyan',
  34.               'Red',      'Magenta',      'Brown',      'LtGray',
  35.               'DarkGray', 'LtBlue',       'LtGreen',    'LtCyan',
  36.               'LtRed',    'LtMagenta',    'Yellow',     'White' );
  37.  
  38.   var
  39.     Ch              : char;
  40.     ColorBack,
  41.     ColorIn,
  42.     ColorOut        : integer;                   { color parms for XorColConv }
  43.     Colr            : text;
  44.     Driver          : integer;
  45.     GRreturn        : integer;
  46.     I               : byte;
  47.     Mode            : integer;
  48.     Txt             : text;
  49.  
  50. { == XorColConv ===============================================================
  51.  
  52. (*// Procedure: XorColConv
  53.  
  54. Purpose:  Calculates color resulting from background XOR foreground in graphics
  55.  
  56. Syntax:   PROCEDURE
  57.           XorColConv( ColBkGnd, ColSet : integer; var ColResult : integer );
  58.  
  59. Parameters:
  60.  
  61.   ColBkGnd     Input background color: VGA 0 (Black) to 15 (White)
  62.   ColSet       Input foreground color: VGA 0-15
  63.   ColResult    Output resulting VGA color of ColSet XOR on ColBkGnd
  64.  
  65. Remarks:  RGB colors in decimal for the 16 "standard" VGA colors
  66.  
  67.           These numbers are calculated by this formula:
  68.  
  69.              ColorValue := ( Red * 65536 ) + ( Green * 256 ) + Blue
  70.  
  71.           example, "standard" LightBlue is Red = $15, Green = $15, Blue = $3F
  72.           This "combines" to give $15153F = 1381695 decimal
  73.  
  74.           The default palette is:
  75.  
  76.            0; Red = $00; Green = $00; Blue = $00)  Black        =       0
  77.            1; Red = $00; Green = $00; Blue = $2A)  Blue         =      42
  78.            2; Red = $00; Green = $2A; Blue = $00)  Green        =   10752
  79.            3; Red = $00; Green = $2A; Blue = $2A)  Cyan         =   10794
  80.            4; Red = $2A; Green = $00; Blue = $00)  Red          = 2752512
  81.            5; Red = $2A; Green = $00; Blue = $2A)  Magenta      = 2752554
  82.            6; Red = $2A; Green = $15; Blue = $00)  Brown        = 2757888
  83.            7; Red = $2A; Green = $2A; Blue = $2A)  LightGray    = 2763306
  84.            8; Red = $15; Green = $15; Blue = $15)  DarkGray     = 1381653
  85.            9; Red = $15; Green = $15; Blue = $3F)  LightBlue    = 1381695
  86.           10; Red = $15; Green = $3F; Blue = $15)  LightGreen   = 1392405
  87.           11; Red = $15; Green = $3F; Blue = $3F)  LightCyan    = 1392447
  88.           12; Red = $3F; Green = $15; Blue = $15)  LightRed     = 4134165
  89.           13; Red = $3F; Green = $15; Blue = $3F)  LightMagenta = 4134207
  90.           14; Red = $3F; Green = $3F; Blue = $15)  Yellow       = 4144917
  91.           15; Red = $3F; Green = $3F; Blue = $3F)  White        = 4144959
  92.  
  93.           This version of XorColConv also writes two text files to the current
  94.           directory: 'coltxt.txt', which is the same as the diagnostic prints
  95.           to the screen and 'col.txt' which is just the raw "exception" values
  96.           before the duplicates are removed.
  97.  
  98.           Duplicates are removed and the exception tables are built by another
  99.           utility program: RECOL3.PAS
  100.  
  101. Refer
  102. Globals:  ColNam[]
  103.           Txt
  104.           Colr
  105.  
  106. Modify
  107. Globals:  None
  108.  
  109. See also:
  110.  
  111. Example:
  112.  
  113.     (*
  114.        Set the input parameters
  115.     *)
  116.     ColorBack := White;
  117.     ColorIn   := LightRed;
  118.     (*
  119.        Create a color graphics "background"
  120.     *)
  121.     SetFillStyle( SolidFill, ColorBack );
  122.     Bar( 0, 0, 639, 479 );
  123.     (*
  124.        Convert White to its resulting XOR output
  125.        In this case, White XOR LightRed = Cyan
  126.  
  127.        Cyan is the inverse of LightRed so it creates true LightRed against
  128.        a white background when used by TextColor.  the "+ 128" forces bit 7
  129.        of TextAttr "on" which causes BIOS writes in graphics to be XOR'd
  130.        unto the screen. Voila! You get LightRed text on White!
  131.     *)
  132.     XorColConv( ColorBack, ColorIn, ColorOut );
  133.     TextColor( ColorOut + 128 );
  134.     writeln( ColNam[ColorIn]:12, ColNam[ColorOut]:12 );
  135.     (*
  136.        Will print: LtRed  Cyan
  137.     *)
  138.     writeln(' This should be ', ColNam[ColorIn] );
  139.     (*
  140.        Will print: This should be LtRed
  141.     *)
  142.  
  143. \\*)
  144.  
  145.   Written by Jerry Rivers. Last modified: 04/16/93
  146.  
  147.   ============================================================================= }
  148.  
  149. PROCEDURE XorColConv( ColBkGnd, ColSet : integer; var ColResult : integer );
  150.   const
  151.     ColVal : array[0..15] of longint = (
  152.                     0,         42,          10752,        10794,
  153.               2752512,    2752554,        2757888,      2763306,
  154.               1381653,    1381695,        1392405,      1392447,
  155.               4134168,    4134207,        4144917,      4144959 );
  156.   var
  157.     Color1, Color2, Color3 : longint;
  158.     I                      : byte;
  159.     OK                     : boolean;
  160.     RGB                    : array[1..30] of longint;        { RGB exceptions }
  161.     Col                    : array[1..30] of integer;  { corresponding colors }
  162.   begin
  163.     {
  164.       Initialize the Color exception tables - developed visually
  165.  
  166.       My tests show there are 16 "exact" color matches (to standard 16-color
  167.       VGA values) plus 29 "exceptions". These exceptions result in nearly but
  168.       not quite exact visual representations of the standard colors. Exception
  169.       values can be mapped to a standard color which looks OK to the eye.
  170.     }
  171.  
  172.     RGB[ 1] := 2757930;  Col[ 1] :=  7;
  173.     RGB[ 2] := 2763264;  Col[ 2] :=  6;
  174.     RGB[ 3] := 4134194;  Col[ 3] := 13;
  175.     RGB[ 4] := 4134165;  Col[ 4] := 12;
  176.     RGB[ 5] := 2768640;  Col[ 5] :=  4;
  177.     RGB[ 6] := 4144920;  Col[ 6] := 14;
  178.     RGB[ 7] := 2768682;  Col[ 7] :=  5;
  179.     RGB[ 8] := 4144946;  Col[ 8] := 15;
  180.     RGB[ 9] :=    5376;  Col[ 9] :=  2;
  181.     RGB[10] := 1381656;  Col[10] :=  8;
  182.     RGB[11] :=    5418;  Col[11] :=  3;
  183.     RGB[12] := 1381682;  Col[12] :=  9;
  184.     RGB[13] :=   16170;  Col[13] :=  1;
  185.     RGB[14] := 4128789;  Col[14] := 14;
  186.     RGB[15] := 4128831;  Col[15] := 15;
  187.     RGB[16] := 4139541;  Col[16] := 12;
  188.     RGB[17] := 4139583;  Col[17] := 13;
  189.     RGB[18] := 1376280;  Col[18] := 10;
  190.     RGB[19] := 1376319;  Col[19] := 11;
  191.     RGB[20] := 1387029;  Col[20] :=  8;
  192.     RGB[21] := 1387071;  Col[21] :=  9;
  193.     RGB[22] := 1392434;  Col[22] := 11;
  194.     RGB[23] := 2752525;  Col[23] :=  4;
  195.     RGB[24] := 2752551;  Col[24] :=  5;
  196.     RGB[25] := 2763277;  Col[25] :=  6;
  197.     RGB[26] := 2763303;  Col[26] :=  7;
  198.     RGB[27] :=      39;  Col[27] :=  1;
  199.     RGB[28] :=   10765;  Col[28] :=  2;
  200.     RGB[29] :=   10791;  Col[29] :=  3;
  201.     {
  202.       Get long integer RGB color numbers for background and "desired" color
  203.     }
  204.     Color1 := ColVal[ ColBkGnd ];
  205.     Color2 := ColVal[ ColSet ];
  206.     Color3 := Color1 XOR Color2;
  207.     {
  208.       If the XOR color matches a "standard" VGA color, you're done!
  209.     }
  210.     I := 0; OK := false;
  211.     repeat
  212.       if Color3 = ColVal[ I ] then
  213.         begin
  214.           ColResult := I;                 { return corresponding color number }
  215.           OK := true;                                     { signal OK to quit }
  216.           write( Txt, OK:5);
  217.           write( Txt, '**' );
  218.           write( OK:5);
  219.           write( '**' );
  220.         end;
  221.         inc( I );
  222.     until ( I > White );
  223.     {
  224.       If the XOR color isn't "standard", look at the "exception" list
  225.  
  226.       This list was built by checking all the Color3's that aren't
  227.       "standard" and visually identifying the matching color
  228.  
  229.       A 29-long look-up table may not be the most efficient, but it works!
  230.     }
  231.     if not OK then begin
  232.         I := 1;
  233.         repeat
  234.           if Color3 = RGB[ I ] then
  235.             begin
  236.               write( Txt, OK );
  237.               write( OK );
  238.               ColResult := Col[ I ];      { return corresponding color number }
  239.               OK := true;                                 { signal OK to quit }
  240.               write( Txt, I:2 );
  241.               write( I:2 );
  242.             end;
  243.           inc( I ) ;
  244.         until OK or ( I > 29 );
  245.       end;
  246.     {
  247.       If the bell rings, a color slipped thru the exception table;
  248.       This should never happen
  249.     }
  250.     if not OK then writeln( chr(7) );
  251.     {
  252.       Set the resulting color the the rest of the diagnostic prints
  253.     }
  254.     TextColor( ColSet + 128 );
  255.     write( (I-1):4, Color2:8, Color1:8, Color3:8, ColResult:3 );
  256.     writeln( ColNam[ ColorIn ]:10, ' ^ ', ColNam[ ColorBack ],
  257.                 ' = ', ColNam[ ColResult ] );
  258.  
  259.     write( Txt, (I-1):4, Color2:8, Color1:8, Color3:8, ColResult:3 );
  260.     writeln( Txt, ColNam[ ColorIn ]:10, ' XOR ', ColNam[ ColorBack ],
  261.                 ' = ', ColNam[ ColResult ] );
  262.  
  263.     writeln( Colr, ColorBack:2, color3:8, ColResult:3 );
  264.  
  265.   end; { XorColConv }
  266.  
  267.   BEGIN  { --- Main Program --- }
  268.     {
  269.       This program assumes you are running standard VGA 16-color graphics
  270.       If you're not, an error will result and the program will stop
  271.     }
  272.     Driver := VGA;
  273.     Mode   := VGAhi;
  274.  
  275.     InitGraph(Driver, Mode, '');
  276.  
  277.     GRreturn := GraphResult;
  278.     if GRreturn <> 0 then begin
  279.         writeln( 'Couldn''t start Scene-may be graphics or video problem' );
  280.         writeln( GraphErrorMsg( GRreturn ) );
  281.         halt;
  282.       end;
  283.     {
  284.       Turn direct video off so standard writeln works in graphics
  285.     }
  286.     DirectVideo := false;
  287.     SetRGBpalette( Brown, $22, $15, $00 );  { adjust VGA Brown to look "browner"
  288.                                               and less like VGA Red }
  289.     {
  290.       Take care of the output text files!
  291.     }
  292.     Assign( Txt, 'coltxt.txt' );
  293.     assign( Colr, 'col.txt' );
  294.     rewrite( Txt );
  295.     rewrite( Colr );
  296.     {
  297.       Do the color matching for every combination of background and foreground
  298.       VGA colors
  299.     }
  300.     for ColorBack := Black to white do
  301.       begin
  302.  
  303.       SetFillStyle( SolidFill, ColorBack );
  304.       Bar( 0, 0, 639, 479 );
  305.  
  306.       TextColor( Black + 128 );        gotoXY( 72, 5 );  writeln( 'Black' );
  307.       TextColor( Blue + 128 );         gotoXY( 72, 6 );  writeln( 'Blue' );
  308.       TextColor( Green + 128 );        gotoXY( 72, 7 );  writeln( 'Green' );
  309.       TextColor( Cyan + 128 );         gotoXY( 72, 8 );  writeln( 'Cyan' );
  310.       TextColor( Red + 128 );          gotoXY( 72, 9 );  writeln( 'Red' );
  311.       TextColor( Magenta + 128 );      gotoXY( 72, 10 ); writeln( 'Magenta' );
  312.       TextColor( Brown + 128 );        gotoXY( 72, 11 ); writeln( 'Brown' );
  313.       TextColor( Lightgray + 128 );    gotoXY( 72, 12 ); writeln( 'LtGray' );
  314.       TextColor( DarkGray + 128 );     gotoXY( 72, 13 ); writeln( 'DkGray' );
  315.       TextColor( Lightblue + 128 );    gotoXY( 72, 14 ); writeln( 'Ltblue' );
  316.       TextColor( Lightgreen + 128 );   gotoXY( 72, 15 ); writeln( 'Ltgreen' );
  317.       TextColor( LightCyan + 128 );    gotoXY( 72, 16 ); writeln( 'Ltcyan' );
  318.       TextColor( Lightred + 128 );     gotoXY( 72, 17 ); writeln( 'Ltred' );
  319.       TextColor( Lightmagenta + 128 ); gotoXY( 72, 18 ); writeln( 'Ltmagenta' );
  320.       TextColor( Yellow + 128 );       gotoXY( 72, 19 ); writeln( 'Yellow' );
  321.       TextColor( White + 128 );        gotoXY( 72, 20 ); writeln( 'White' );
  322.  
  323.       gotoXY( 1, 5 );
  324.       for ColorIn := Black to White do
  325.         XorColConv( ColorBack, ColorIn, ColorOut );
  326.  
  327.       writeln;
  328.       write( 'Press any key to continue, ESC to quit now ' );
  329.       Ch := ReadKey;
  330.       if Ch = #27 then halt;
  331.  
  332.     end; { for ColorBack }
  333.  
  334.     close( Txt );
  335.     close( Colr );
  336.  
  337.   END.
  338.